MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 03 - 1987/03.03 Mar 87/Pascal Graf3D/threeD.pas (turbo)

Text File | 1986-12-07 | 14.9 KB | 504 lines | [TEXT/TPAS]

{******************************************    }
{    Graf3D Demo                                                    }
{                                                                            }
{    by Scott Berfield                                           }
{    for MacTutor magazine                                    }
{                                                                            }
{    History: Version one October 29, 1986        }
{        using Lightspeed Pascal    converted to     }
{    Turbo Pascal December 7, 1986                }
{                                                                            }
{******************************************    }

PROGRAM DEMO;
{$R My Threed.rsrc} {link the resource file}
{$U-}               {Turn off default USES}
{$B+}               {Set the bundle bit}
{$D+}               {Turn on procedure names for debugging}
{$T APPL!@#$}       {Set creator and type}

    USES
    MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf, fixmath, graf3d;

 CONST
        object = 1;    {flag indicating which we are currently rotating}
        world = 2;
        hellfreezesover = false;        {A never-changing boolean for eventloop}
        VIEWwindowID = 32000;        {ID of our drawing window}
        INPUTWINDOWID = 32001;    {ID of our control window}
        APPLEM = 0;                    {Menu indices}
        FILEM = 1;
        EDITM = 2;
        SWITCHM = 3;
        appleID = 128;                {Menu resource IDs}
        fileID = 129;
        editID = 130;
        SWITCHID = 131;
        lastmenu = 3;                    {How many menus}
        aboutID = 128;                {About alert resource ID}
        UndoItem = 1;                    {Menu item codes}
        cutitem = 3;
        copyitem = 4;
        pasteitem = 5;
        clearitem = 6;
        XScrollID = 128;                {Scroll bar resource IDs}
        YScrollID = 129;
        ZScrollID = 130;
        XMIN = -200;                    {Limits for object space (set with LOOKAT)}
        YMIN = -200;
        ZMIN = -200;
        XMAX = 200;
        YMAX = 200;
        ZMAX = 200;

    VAR
        fromupdate : boolean;
        whichcontrol : controlhandle;                        {which control was hit?}
        xscroll, yscroll, zscroll : controlhandle;                {storage for scrollbars}
        myMenus : ARRAY[0..lastmenu] OF menuhandle;    {our menus}
        INPUTWINDOW : windowptr;                        {pointers to our windows}
        VIEWWindow : windowPtr;
        Wrecord : windowrecord;                            {Storage for our windows}
        Wrecord2 : windowrecord;
        gport3d : port3d;                                    {Our 3D grafport}
        XROT, YROT, ZROT : integer;                        {current scrollbar settings}
        OXROT, OYROT, OZROT : integer;                    {old scroll bar settings}
        which : integer;                                        {Object or world rotation?}
        XSpacerot, YSpaceRot, ZSpaceRot : integer;        {how much is space rotated?}
        XObjRot, YObjRot, ZObjRot : integer;                {how much is the object rotated?}
        Dtetra, tetra : ARRAY[1..4] OF point3d;                {the original and the transformed tetrahedra}
        delta : integer;                                         {inc or dec the scroll bars}

    PROCEDURE init;    {set everything up}
    BEGIN
        initgraf(@thePort);
        initgrf3d(@theport3d);    {this is the graf3D equivalent. It IS NOT optional}
        InitFonts;
        FlushEvents(everyEvent, 0);
        InitWindows;
        InitMenus;
        TEInit;
        InitDialogs(NIL);
        InitCursor;
        XROT := 0;            {Set initial values for everything}
        YROT := 0;
        ZROT := 0;
        OXROT := 1;
        OYROT := 1;
        OZROT := 1;
        XSpaceRot := 0;
        YSpaceRot := 0;
        ZSpaceRot := 0;
        XObjRot := 0;
        YObjRot := 0;
        ZObjRot := 0;
        which := object;        {the default is to rotate the object}
        setpt3d(tetra[1], 0, -6553600, 0); {set the tetrahedron's vertices}
        setpt3d(tetra[2], -1638400, -3276800, 0);
        setpt3d(tetra[3], 1638400, -3276800, 0);
        setpt3d(tetra[4], 0, -4915200, 1638400);
        DTetra := tetra;
    END;                 {init}

    PROCEDURE drawvalues;        {Draw the current scroll bar settings as text}
        VAR
            text1, text2, text3 : str255;
            trect : rect;
    BEGIN
        IF (OXROT <> XROT) OR (OYROT <> YROT) OR (OZROT <> ZROT) OR (fromupdate) THEN
            BEGIN                                        {we only draw them if only if something has changed}
                setrect(trect, 0, 45, 512, 65);
                setport(inputwindow);
                eraserect(trect);
                penpat(black);
                textfont(0);
                textsize(12);
                numtostring(xrot, text1);
                numtostring(yrot, text2);
                numtostring(zrot, text3);
                moveto(10, 55);
                drawstring(text1);
                moveto(175, 55);
                drawstring(text2);
                moveto(340, 55);
                drawstring(text3);
                OXROT := XROT;
                OYROT := YROT;
                OZROT := ZROT;
            END;
    END;                 {drawvalues}

    PROCEDURE drawlabels;    {label the scroll bars}
        VAR
            labelrect : rect;
    BEGIN
        setrect(labelrect, 0, 0, 512, 24);
        setport(inputwindow);
        eraserect(labelrect);
        textfont(0);        {Chicago font}
        textsize(12);        {12 point}
        penpat(black);    {make sure we can see it}
        CASE which OF    {which labels do we draw?}
            object :
                BEGIN
                    moveto(10, 19);
                    drawstring('X Rotation');
                    moveto(175, 19);
                    drawstring('Y Rotation');
                    moveto(340, 19);
                    drawstring('Z Rotation');
                END;
            world :
                BEGIN
                    moveto(10, 19);
                    drawstring('Pitch');
                    moveto(175, 19);
                    drawstring('Yaw');
                    moveto(340, 19);
                    drawstring('Roll');
                END;
        END;
    END;            {drawlabels}

    PROCEDURE drawgrid;        {Draw the “space grid”}
        VAR
            i : integer;
    BEGIN                                {all coordinates must be in fixed point — multiply by 65536}
        pitch(XSPACEROT * 65536);    {rotate space by x value...}
        YAW(YSPACEROT * 65536);    {rotate space by y value...}
        ROLL(ZSPACEROT * 65536);    {rotate space by z value...}
{now draw the grid in the newly rotated space}
        moveto3d(-6553600, 0, -6553600);         {-100,0,-100}
        lineto3d(-6553600, 0, 6553600);            {etc...}
        lineto3d(6553600, 0, 6553600);
        lineto3d(6553600, 0, -6553600);
        lineto3d(-6553600, 0, -6553600);
        moveto3d(0, 0, -6553600);
        lineto3d(0, 0, 6553600);
        moveto3d(-6553600, 0, 0);
        lineto3d(6553600, 0, 0);
{when we leave (to go back to procedure drawview) space is still rotated}
    END;                                {drawgrid}

    PROCEDURE drawtetra;    {draw our object}
    BEGIN
        moveto3d(Dtetra[1].x, Dtetra[1].y, Dtetra[1].z);    {we draw using the DTetra array which}
        lineto3d(Dtetra[2].x, Dtetra[2].y, Dtetra[2].z);        {holds the transformed coordinates}
        lineto3d(Dtetra[3].x, Dtetra[3].y, Dtetra[3].z);        {Note that point3D's are already in}
        lineto3d(Dtetra[1].x, Dtetra[1].y, Dtetra[1].z);        {fixed - point }
        lineto3d(Dtetra[4].x, Dtetra[4].y, Dtetra[4].z);
        moveto3d(Dtetra[2].x, Dtetra[2].y, Dtetra[2].z);
        lineto3d(Dtetra[4].x, Dtetra[4].y, Dtetra[4].z);
        lineto3d(Dtetra[3].x, Dtetra[3].y, Dtetra[3].z);
    END;                        {drawtetra}

    PROCEDURE drawview;    {draw the contents of the view window using current transform matrix}
    BEGIN
        setport(viewwindow);    {where we need to be to draw}
        penpat(black);            {eraser color}
        paintrect(theport^.portrect);    {erase the screen}
        penpat(white);            {line color}
        drawgrid;                    {draw the plane — space has been rotated when we return}
        drawtetra;                {draw the object}
        identity;                    {reset the transform matrix so we can figure next setting}
        setport(inputwindow);    {Back to the control window for more scroll bar action!}
    END;                            {Drawview}

    PROCEDURE drawinput;    {Draw the control window}
    BEGIN
        setport(inputwindow);
        drawvalues;
        drawlabels;
        Drawcontrols(inputwindow);
    END;                            {drawinput}

    PROCEDURE TRANS;    {transformation based on current scroll bar settings}
        VAR
            i : integer;
    BEGIN
        PITCH(XROT * 65536);    {x rotation}
        YAW(YROT * 65536);    {y rotation}
        ROLL(ZROT * 65536);    {z rotation}
        IF which = object THEN    {if we are rotating the object...}
            FOR i := 1 TO 4 DO
                BEGIN
                    transform(tetra[i], Dtetra[i]);    {we apply the matrix to each point in the virgin tetra and}
                END;                                    {store it in the drawing tetra}
        identity;                    {in any case, we reset the matrix before we draw the window}
        drawview;                {so that the drawview procedure can control the global viewpoint}
    END;                {TRANS}


    PROCEDURE updateRots;    {update values from scroll bars}
    BEGIN
        XROT := GETCTLVALUE(XSCROLL);    {get the current values}
        YROT := GETCTLVALUE(YSCROLL);
        ZROT := GETCTLVALUE(ZSCROLL);
        DrawValues;                            {draw them}
        CASE which OF
            object :                                 {which values need updating?}
                BEGIN
                    XObjRot := XROT;
                    YOBJROT := YROT;
                    ZOBJROT := ZROT;
                    TRANS;
                END;
            world :
                BEGIN
                    XspaceRot := XROT;
                    YspaceROT := YROT;
                    ZspaceROT := ZROT;
                    drawview;
                END;
        END;
    END;                    {updaterots}


    PROCEDURE dowindows;        {set up the windows and the 3D stuff}
        VAR
            Vrect : rect;
    BEGIN
        InputWindow := GetNewWindow(INPUTWINDOWID, @Wrecord2, POINTER(-1));
        xScroll := GetNewControl(XScrollID, InputWindow);
        yScroll := GetNewControl(YScrollID, InputWindow);
        zScroll := GetNewControl(ZScrollID, InputWindow);
        ViewWindow := GetNewWindow(VIEWWINDOWID, @Wrecord, POINTER(-1));
{set up a 3D grafport (it uses the reg. grafport for drawing}
        Open3DPort(@gPort3D);
        setport3d(@gPort3d);
        viewport(viewwindow^.portbits.bounds);    {set the drawing area to the full window}
        lookat(XMIN * 65536, YMIN * 65536, XMAX * 65536, YMAX * 65536);    {set the image space}
{set the angle… 25° = human field of view.  0°=no persp.  80°=fish-eye lens}
        viewangle(1638400);     {25° * 65536}
    END;                            {doWindows}


    PROCEDURE domenus;    {set up menus}
        VAR
            i : integer;
    BEGIN
        myMenus[appleM] := GetMenu(appleID);
        AddResMenu(myMenus[appleM], 'DRVR');
        myMenus[FileM] := GetMenu(fileID);
        myMenus[EditM] := GetMenu(editID);
        mymenus[SwitchM] := GetMenu(switchID);
        FOR i := appleM TO lastmenu DO
            insertMenu(myMenus[i], 0);
        SetItemIcon(myMenus[0], 1, 195);
        DrawMenuBar;
    END;        {doMenus}

    PROCEDURE aboutme;    {do about box}
        VAR
            foo : integer;
    BEGIN
        foo := alert(aboutID, NIL);
    END;        {aboutme}


    PROCEDURE applfile (theItem : integer);        {handle file menu}
    BEGIN
        exittoshell;        {they chose Quit}
    END;            {applfile}

    PROCEDURE DoCommand (theCommand : LongInt);    {handle menu choices}
        VAR
            theMenu, theItem : integer;
            name : str255;
            RefNum : integer;
            dum : integer;
            blah : boolean;
    BEGIN
        theMenu := hiWord(theCommand);
        theItem := loWord(theCommand);
        CASE theMenu OF
            AppleID :
                BEGIN
                    IF (theItem = 1) THEN
                        AboutMe                                                {about box}
                    ELSE
                        BEGIN
                            getItem(myMenus[appleM], theItem, name);        {selected a desk accessory}
                            dum := OpenDeskAcc(Name)
                        END;         {else}
                END;             {appleM}

            FileID :
                ApplFile(theItem);

            EditID :
                blah := systemEdit(theItem - 1);

            SwitchID :
                BEGIN
                    CASE which OF            {adjust menuand controls to reflect which we are rotating now}
                        object :                 {we were rotating the object, now we switch to rotating space}
                            BEGIN
                                which := world;
                                setitem(mymenus[switchM], 1, 'Rotate Object');
                                setport(inputwindow);
                                drawlabels;
                                setctlvalue(xscroll, xspacerot);    {pick up the settings from the space values}
                                setctlvalue(yscroll, yspacerot);
                                setctlvalue(zscroll, zspacerot);
                                xrot := xspacerot;                    {update our holders}
                                yrot := yspacerot;
                                zrot := zspacerot;
                                drawvalues;                            {draw the values for the scroll bars}
                            END;                        {object case}
                        world :
                            BEGIN                    {switching from world to object rotations}
                                which := object;
                                setitem(mymenus[switchM], 1, 'Rotate Space');
                                setport(inputwindow);
                                drawlabels;
                                setctlvalue(xscroll, xobjrot);
                                setctlvalue(yscroll, yobjrot);
                                setctlvalue(zscroll, zobjrot);
                                xrot := xobjrot;
                                yrot := yobjrot;
                                zrot := zobjrot;
                                drawvalues;
                            END;                    {world case}
                        OTHERWISE
                    END;            {case which of}
                END;    {switch menu case}
            OTHERWISE
        END;     {case theMenu}
        hiliteMenu(0);    {turn off menu hilight}
    END; {doCommand}

    PROCEDURE changearrow;
    BEGIN
        setctlvalue(whichcontrol, getctlvalue(whichcontrol) + delta);
        updaterots;
    END;

    PROCEDURE ApplMouseDown (theWindow : windowPtr;
                                    MousePoint : point);        {handle scroll bars}
        VAR
            partcode : integer;
            dummy, temp : integer;
    BEGIN
        IF theWindow = inputwindow THEN
            BEGIN
                setport(inputwindow);
                globaltolocal(mousepoint);
                partcode := findcontrol(mousepoint, theWindow, whichcontrol);
                CASE partcode OF
                    inupbutton :
                        BEGIN
                            delta := -1;
                            dummy := trackcontrol(whichcontrol, mousepoint, @changearrow);
                        END;
                    indownbutton :
                        BEGIN
                            delta := 1;
                            dummy := trackcontrol(whichcontrol, mousepoint, @changearrow);
                        END;
                    inpageup :
                        BEGIN
                            delta := -10;
                            dummy := trackcontrol(whichcontrol, mousepoint, @changearrow);
                        END;
                    inpagedown :
                        BEGIN
                            delta := 10;
                            dummy := trackcontrol(whichcontrol, mousepoint, @changearrow);
                        END;
                    inthumb :
                        BEGIN
                            temp := getctlvalue(whichcontrol);
                            dummy := trackcontrol(whichcontrol, mousepoint, NIL);
                            IF getctlvalue(whichcontrol) <> temp THEN
                                updaterots;
                        END;
                    OTHERWISE
                END;    {case partcode of}
            END;        {if}
    END;         {applMouseDown}


    PROCEDURE DoKeyDown (Event : EventRecord);        {they pressed a key}
        VAR
            CharCode : char;
    BEGIN
        CharCode := chr(Event.message MOD 256);
        IF BitAnd(Event.modifiers, CmdKey) = CmdKey THEN        {must of been a command key, right?}
            DoCommand(MenuKey(CharCode))                            {pass it to menu handler}
    END;  { DoKeyDown }

    PROCEDURE EventLoop;        {the meat of the Mac application — process those events!}
        VAR
            saveport : GrafPtr;
            GotEvent : boolean;
            NewEvent : EventRecord;
            WhichWindow : WindowPtr;
            Key : char;
            KeyCommand : LongInt;
    BEGIN
        flushevents(everyevent, 0);
        REPEAT
            GotEvent := GetNextEvent(EveryEvent, NewEvent);
            IF GotEvent THEN
                BEGIN
                    CASE NewEvent.What OF
                        mouseDown :
                            BEGIN
                                CASE FindWindow(NewEvent.where, whichWindow) OF
                                    inMenuBar :
                                        doCommand(menuSelect(NewEvent.where));
                                    inSysWindow :
                                        SystemClick(newEvent, whichWindow);
                                    inContent :
                                        applMouseDown(whichWindow, NewEvent.where); {case inContent}
                                    inGoAway :
                                        IF TrackGoAway(whichWindow, NewEvent.Where) THEN
                                            BEGIN
                                                ExitToShell;
                                            END;
                                    inDrag :
                                        IF whichWindow <> FrontWindow THEN
                                            SelectWindow(whichWindow)
                                        ELSE
                                            applMouseDown(whichWindow, NewEvent.where);
                                    OTHERWISE
                                END; {case FWReturnCode}
                            END; {case mouseDown}

                        KeyDown :
                            BEGIN
                                doKeyDown(newEvent);
                            END; {Case KeyDown}

                        UpdateEvt :
                            BEGIN
                                getport(saveport);            {store current grafport}
                                setport(viewwindow);        {set it to the viewwindow}
                                beginupdate(viewwindow);
                                drawview;
                                endupdate(viewwindow);
                                setport(inputwindow);        {now do the control window}
                                beginupdate(inputwindow);
                                fromupdate := true;            {used to draw the values if needed}
                                drawinput;
                                fromupdate := false;            {reset the toggle}
                                endupdate(inputwindow);
                                setport(saveport);            {restore the port}
                            END;     {updateEvt}
                        OTHERWISE
                    END;     {NewEvent.What}
                END;     {if}
            systemTask;    {handle periodic stuff}
        UNTIL HellFreezesOver;    {let it run for a good long time}
    END; {EventLoop}

BEGIN
    init;                {Init all toolbox stuff as well as application variables}
    dowindows;        {draw the windows and setup 3D grafport}
    domenus;        {do the menus}
    identity;            {reset the transformation matrix (just in case)}
    drawview;        {draw the contents of the view window}
    drawinput;        {draw the contents of the control window}
    eventloop;        {Handle the events}
END.            {That's all for now…}